Geo-Visualisierung

Aufgabenstellung:

Die Aufgabe besteht in der Darstellung von Daten im Kontext geographischer Karten, z.B. Wahlkreise und der Anteil von Stimmen für bestimmte Parteien und die Arbeitslosenquote in diesen Bezirken.

Einführung

Im Folgenden wird in die geographische Visualisierung mit R eingeführt. Es werden die Grundlagen zum Darstellen von Daten in geographischem Kontext behandelt sowie an zwei konkreten Beispielen vorgestellt. Dabei werden unter anderem Flächenwertstufenkarten verwendet.

Zeichnen von geographischen Karten

Die Grundlage zum Zeichnen von geographischen Grenzen bilden die sogenannten Shape-Files. In diesem Format lassen sich Geometriedaten leicht darstellen. In diesem Projekt wird ein Shape-File zur Darstellung der Grenzen der deutschen Bundesländer verwendet. Ein Shape-File ist ein Dateiformat welches geographische Vektordaten enthält. Es eignet sich unteranderem zum Zeichnen von Grenzen. Dieses Shape-File wird von dem Bundesamt für Kartographie und Geodäsie bereitgestellt. Im Folgenden Code-Ausschnitt wird das Shape-File eingelesen und beispielhaft die darin enthaltenen Daten ausgegeben.

#import map
map <- st_read("data/2500_NUTS1.shp", stringsAsFactors=FALSE)

## Reading layer `2500_NUTS1' from data source `/Users/nahkusaidy/Documents/Repositories/GeoVisualisation/data/2500_NUTS1.shp' using driver `ESRI Shapefile'
## Simple feature collection with 16 features and 3 fields
## geometry type:  MULTIPOLYGON
## dimension:      XY
## bbox:           xmin: 3280341 ymin: 5237533 xmax: 3921264 ymax: 6103334
## epsg (SRID):    31467
## proj4string:    +proj=tmerc +lat_0=0 +lon_0=9 +k=1 +x_0=3500000 +y_0=0 +ellps=bessel +towgs84=598.1,73.7,418.2,0.202,0.045,-2.455,6.7 +units=m +no_defs

#transform coordinate system to common cordinate system
map = st_transform(map,3857)

#plot the shape-file
ggplot(map) + geom_sf()

Neben reinen Shape-Files gibt es in R die Möglichkeit auch realitätsnähere Karten zu zeichnen. Hier wird beispielhaft eine Karte von Deutschland von OpenStreetMap gezeichnet.

#get a map of germany from openstreetmap.org
germany_map <- get_map(getbb("Deutschland", base_url = "https://nominatim.openstreetmap.org", featuretype = "country"),maptype = "toner-background")
#plot openstreetmap
ggmap(germany_map)

Binnenwanderung

Um die Möglichkeiten der Darstellung von Daten in geographischem Kontext zu demonstrieren werden nun Daten aus einem Datensatz zur Binnenwanderung in Deutschland analysiert und dargestellt. Dieser wird zuerst importiert und die zu visualisierenden Daten in Data Frames verpackt. Die Daten enthalten das Saldo der Binnenwanderung für jedes Bundesland von Deutschen und Ausländern.

domestic_migration_data <- read_excel("data/domestic_migration.xlsx")

## New names:
## * `` -> ...2

#get the german states names from the shape-file map
states <- map$NUTS_NAME
#create a new dataframe which will contain the domestic migration data from 2003-2017
movement_per_state <- data.frame(matrix(ncol = 16, nrow = 16))

#name data frame columns
data_frame_column_names <- c("NUTS_NAME",sprintf("%s",2003:2017))
colnames(movement_per_state) <- data_frame_column_names

#create a new data frame which will contain the mean of domestic migration per state
movement_per_state_mean <- data.frame(NUTS_NAME = c(1:16), Mean_Migration = c(1:16))
#create a new data frame which will contain the sum of domestic migration per state
movement_per_state_sum <- data.frame(NUTS_NAME = c(1:16), Sum_Migration = c(1:16))

#fill the data frames with data
for(i in 1:length(states)){
  #get the index of the row containing the domestic migration data for each state
  index <- which(domestic_migration_data == states[i], arr.ind = TRUE)[1]+2
  #get the relevant data for the indexed state
  row_data = domestic_migration_data[index,-1:-3]
  #concatenate the state name and domestic migration data
  data_frame_row = c(c(states[i]), row_data)
  #name the columns of the row that is to be appended to the data frame
  names(data_frame_row) <- data_frame_column_names
  
  movement_per_state[i,] = data_frame_row
  
  movement_per_state_mean$NUTS_NAME[i] = states[i]
  #add mean domestic migration from 2003 to 2017 per state to data frame
  movement_per_state_mean$Mean_Migration[i] = mean(as.numeric(as.character(row_data)))
  
  movement_per_state_sum$NUTS_NAME[i] = states[i]
  #add sum of domestic migration from 2003 to 2017 per state to data frame
  movement_per_state_sum$Sum_Migration[i] = sum(as.numeric(as.character(row_data)))
}

#show the structure of the created data frames

str(movement_per_state)

## 'data.frame':    16 obs. of  16 variables:
##  $ NUTS_NAME: chr  "Baden-Württemberg" "Bayern" "Berlin" "Brandenburg" ...
##  $ 2003     : num  26926 34212 -7043 -498 673 ...
##  $ 2004     : num  22055 25695 -9133 742 1131 ...
##  $ 2005     : num  15394 29432 -4328 -522 810 ...
##  $ 2006     : num  5673 34153 1955 -3045 1371 ...
##  $ 2007     : num  10039 31477 7377 -4021 -292 ...
##  $ 2008     : num  12840 26151 12958 -4102 222 ...
##  $ 2009     : num  1070 15632 18353 -2173 1590 ...
##  $ 2010     : num  -1604 10746 17990 -1518 852 ...
##  $ 2011     : num  1054 15363 15341 -1596 -564 ...
##  $ 2012     : num  1880 15486 12134 1252 -378 ...
##  $ 2013     : num  -1315 14085 8068 4275 -635 ...
##  $ 2014     : num  -398 6677 2672 8921 -1910 ...
##  $ 2015     : num  1273 4011 -4628 12315 -3182 ...
##  $ 2016     : num  -4388 -1741 7891 9873 920 ...
##  $ 2017     : num  -5107 6593 -3013 14458 -2916 ...

str(movement_per_state_mean)

## 'data.frame':    16 obs. of  2 variables:
##  $ NUTS_NAME     : chr  "Baden-Württemberg" "Bayern" "Berlin" "Brandenburg" ...
##  $ Mean_Migration: num  5693 17865 5106 2291 -154 ...

str(movement_per_state_sum)

## 'data.frame':    16 obs. of  2 variables:
##  $ NUTS_NAME    : chr  "Baden-Württemberg" "Bayern" "Berlin" "Brandenburg" ...
##  $ Sum_Migration: num  85392 267972 76594 34361 -2308 ...

Diese Daten werden aufgesplittet in neue und alte Bundesländer, wobei Berlin als altes Bundesland gezählt wird, da im Datensatz nicht zwischen West- und Ostberlin unterschieden wird.

new_states = c("Brandenburg","Mecklenburg-Vorpommern","Sachsen","Sachsen-Anhalt","Thüringen")
#get domestic migration data only for the new german states
new_states_movement = movement_per_state[movement_per_state$NUTS_NAME %in% new_states,]
#remove douplicates (there are 5 new states excluding Berlin)
new_states_movement = new_states_movement[1:5,]
#comupte sum of domestic migration in the new german states for each year
data_of_new_states = colSums(new_states_movement[,-1])

#create a notin operator
`%notin%` <- Negate(`%in%`)

#get domestic migration data only for the old german states (analogue to the procedure above)
old_states_movement = movement_per_state[movement_per_state$NUTS_NAME %notin% new_states,]
#there are 11 old states including berlin
old_states_movement = old_states_movement[1:11,]
data_of_old_states = colSums(old_states_movement[,-1])

Im Folgenden wird der Vergleich des Saldos der Binnenwanderung zwischen den neuen und alten Bundesländern zwischen 2003 und 2017 in einem Plot dargestellt.

Es ist zu erkennen, dass die Abwanderung von Einwohnern von Ost- nach Westdeutschland bis 2013 immer weiter abgenommen hat. Danach kam es 2014 erstmals zu einer Abwanderung von Einwohnern von West- nach Ostdeutschland.
Eine geographische Darstellung des Durchschnitts des Saldos der Binnenwanderung je Bundesland lässt sich mit folgendem Code realisieren. Dabei wird die OpenStreetMap als Hintergrund verwendet und die Wahlergebnisse werden darauf auf Basis des Shape-Files dargestellt.

#function to convert a map from the 4326 coordinate reference system (crs) to the 3857 crs
ggmap_bbox <- function(map) {
  # Extract the bounding box (in lat/lon) from the ggmap to a numeric vector, 
  # and set the names to what sf::st_bbox expects:
  map_bbox <- setNames(unlist(attr(map, "bb")), 
                       c("ymin", "xmin", "ymax", "xmax"))
  
  # Coonvert the bbox to an sf polygon, transform it to 3857, 
  # and convert back to a bbox (convoluted, but it works)
  bbox_3857 <- st_bbox(st_transform(st_as_sfc(st_bbox(map_bbox, crs = 4326)), 3857))
  
  # Overwrite the bbox of the ggmap object with the transformed coordinates 
  attr(map, "bb")$ll.lat <- bbox_3857["ymin"]
  attr(map, "bb")$ll.lon <- bbox_3857["xmin"]
  attr(map, "bb")$ur.lat <- bbox_3857["ymax"]
  attr(map, "bb")$ur.lon <- bbox_3857["xmax"]
  map
}

#convert the openstreetmap to 3857 crs
#otherwise the plots wouldn't be a precise overlay
germany_map <- ggmap_bbox(germany_map)
#merge shape-file map and data to display by state name
merged_movement_mean <- left_join(map,movement_per_state_mean,by="NUTS_NAME")
ggmap(germany_map) + coord_sf(crs=st_crs(3857)) + geom_sf(data=merged_movement_mean, aes(fill= Mean_Migration), inherit.aes = FALSE,alpha=0.5)+
  scale_fill_gradient2("Anzahl Personen",low= "#CC0033", mid="white",high = "#006633") + ggtitle("Durchschnitt des Saldos der Binnenwanderung in Deutschland")

Das gesamte Saldo von 2013 bist 2017 ist im nächsten Plot dargestellt.

#merge shape-file map and data to display by state name
merged_movement_sum<- left_join(map,movement_per_state_sum,by="NUTS_NAME")
ggmap(germany_map) + coord_sf(crs=st_crs(3857)) + geom_sf(data=merged_movement_sum, aes(fill= Sum_Migration), inherit.aes = FALSE,alpha=0.7)+
  scale_fill_gradient2("Anzahl Personen",low= "#CC0033", mid="white",high = "#006633") + ggtitle("Summe des Saldos der Binnenwanderung in Deutschland")

Wahlergebnisse der AfD und mögliche Korrelation mit dem verfügbaren Einkommen

Im 2. Teil dieser Ausarbeitung wird ein weiterer Anwendungsfall zur geographischen Visualisierung behandelt. Es sollen die Wahlergebnisse der AfD bei der Bundestagswahl und das Einkommen der Bevölkerung visualisiert werden. Außerdem soll auf einen möglichen Zusammenhang der beiden Größen geprüft werden.

Im Folgenden werden die Wahlergebnisse der AfD 2017 bei der Bundestagswahl und das verfügbare Einkommen pro Einwohner importiert (Quelle verfügbares Einkommen, Quelle AfD Wahlergebnisse).

#import election data from the german election of 2017
votes <- read.csv(file="data/btw17_kerg.csv", sep=";")
#create a data frame for total votes and AfD votes per state
extracted_votes <- data.frame(Votes = votes$X.16, VotesAfD = votes$X.44)

#convert to numeric type
extracted_votes$Votes <- as.numeric(as.character(extracted_votes$Votes))
extracted_votes$VotesAfD <- as.numeric(as.character(extracted_votes$VotesAfD))

#compute the percentage of AfD votes per state
extracted_votes$PercentageAfD <- (extracted_votes$VotesAfD/extracted_votes$Votes)*100

#create a dataframe containing the percentage of AfD votes per state
votes_per_state <- data.frame(NUTS_NAME = c(1:16), Votes_AfD = c(1:16))
for(i in 1:length(states)){
  votes_per_state$NUTS_NAME[i] = states[i]
  votes_per_state$Votes_AfD[i] <- extracted_votes$PercentageAfD[which(votes == states[i], arr.ind = TRUE)]
}

#import income statistics and create data frame
income <- read.csv(file="data/income.csv", sep=";", colClasses=c("NULL", NA))
income <- data.frame(NUTS_NAME = map$NUTS_NAME, Income = income)

Hier wird nun das durchschnittliche verfügbare Einkommen pro Person pro Jahr und der Stimmenanteil der AfD pro Bundesland bei der Bundestagswahl 2017 in Deutschland dargestellt.

merged_votes <- left_join(map,votes_per_state,by="NUTS_NAME")

merged_income <- left_join(map,income,by="NUTS_NAME")

ggmap(germany_map) + coord_sf(crs=st_crs(3857)) + geom_sf(data=merged_votes, aes(fill= Votes_AfD), inherit.aes = FALSE,alpha=0.7)+
  scale_fill_gradient2("Stimmenanteil der AfD in %",low= "white", high = "#00008B")  + ggtitle("Stimmenanteil der AfD")

ggmap(germany_map) + coord_sf(crs=st_crs(3857)) + geom_sf(data=merged_income, aes(fill= Income), inherit.aes = FALSE,alpha=0.7)+
  scale_fill_gradient2("Haushaltsjahreseinkommen\npro Person in €",low= "white", high = "#00008B") + ggtitle("Durchschnittliches Einkommen")

Nun wird das Wahlergebnis der AfD in Abhängigkeit des verfügbaren Haushaltsjahreskommen dargestellt.

x <- income[,2]
y <- votes_per_state[,2]
plot(x,y,ylab = "Stimmen für die AFD in %", xlab = "Durchschnittliches Hauhaltsjahreseinkommen pro Person in €",main ="Zusammenhang zwischen Nettohaushaltseinkommen\n und Wahlergebnis der AfD")

Im Plot ist eine Tendenz zu erkennen, dass niedrige verfügbare Haushaltsjahreseinkommen eher mit einer höheren AfD Wahlquote einhergehen.

cor.test(x,y,method="pearson")

## 
##  Pearson's product-moment correlation
## 
## data:  x and y
## t = -3.1991, df = 14, p-value = 0.006433
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.8664422 -0.2273896
## sample estimates:
##        cor 
## -0.6498455

Es besteht eine deutlich negative Korrelation zwischen dem durchschnittlichen Nettohaushaltseinkommen und dem AfD Wahlergebnis. Dies bedeutet, dass es einen statistischen Zusammenhang zwischen der Wahlquote der AfD und dem Nettohaushaltseinkommen besteht.

Geo_Visualisation